Mehr ggplot2!

Datensatz

install.packages("tidytuesdayR")

characters <- tidytuesdayR::tt_load("2022-08-16")

  • Psychometrische, crowd-sourced ratings für TV-Charaktere.
  • Zwei (mehr oder weniger) gegensätzliche Eigenschaften, werden auf einer Skala von 0 - 100 bewertet.

Foto von Ilse Orsel auf Unsplash

Ziel

Wir wollen jetzt Charactereigenschaften von Personen aus zwei TV-Shows vergleichen. Ich nehme Friends und How I Met Your Mother.

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()

Let’s build a plot!

Skalen und Legenden

Scales in ggplot2 control the mapping from data to aesthetics. They take your data and turn it into something that you can see, like size, colour, position or shape. (ggplot2: Elegant Graphics for Data Analysis)

Legenden

  • Legenden werden automatisch erzeugt.
  • Jede Skala bekommt eine Legende zugeordnet.
  • Sie nehmen die grafischen Eigenschaften (Aesthetics) und ordnen sie den Datenwerten zu. Man kann sie daher als die „Umkehrfunktion“ der jeweiligen Skalen verstehen.

Legenden und Achsen sind funktional äquivalent und werden in ggplot2 unter dem Begriff guides zusammengefasst.

Jede Aesthetic im Plot ist mit genau einer Skala verbunden:

Implizite Definition

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, 
                y = avg_rating, 
                colour = char_name, 
                shape = uni_name)) +
  geom_point()

Wird intern zu:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_x_discrete() +
  scale_y_continuous() +
  scale_colour_discrete() +
  scale_shape_discrete()




  • question ist eine diskrete Variable: scale_x_discrete()
  • avg_rating ist kontinuierlich: scale_x_continuous()
  • char_name und uni_name sind diskret: scale_colour_discrete() und scale_shape_discrete()

Das können wir uns zunutze machen, um manuell Scales zu definieren.

Ändern der Skalen-Defaults

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_x_discrete(name = "Eigenschaft") +
  scale_y_continuous(name = "Mittleres Rating") +
  scale_colour_discrete(name = "Charakter") +
  scale_shape_discrete(name = "Serie")

Eigentlich würden wir dafür labs(x = "Eigenschaft", y = "Mittleres Rating", color = "Charakter", shape = "Serie") nutzen. Wir sehen so aber, dass Achsen- und Legendentitel jeweils Skalennamen sind.

Skalentypen

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = avg_rating, shape = uni_name)) +
  geom_point() +
  scale_y_log10(name = "Mittleren Rating log") +
  scale_colour_continuous()

Hier haben wir jetzt eine log-transormierende und eine kontinuierliche Skala.

Eine Übersicht über die möglichen Skalentypen findet sich hier.

Anwendungsfälle: Farben/Formen

Oft macht es Sinn, die Farben direkt über einen named vector zu definieren. Dadurch bekommen alle Plots, die diese Variablen nutzen, auch sicher die gleichen Aesthetics zugeordnet. Dadurch wird jedem Element in der color-variable genau die gewünschte Farbe zugeordnet:

char_colors <- c(
    "Ted Mosby" = "blue", "Robin Scherbatsky" = "red", "Barney Stinson" = "green", "Lily Aldrin" = "purple", "Marshall Eriksen" = "orange", "Rachel Green" = "pink", "Monica Geller" = "brown", "Phoebe Buffay" = "yellow", "Joey Tribbiani" = "cyan")
char_shapes <- c("Friends" = 12, "How I Met Your Mother" = 18)

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point(size = 3) +
  scale_shape_manual(values = char_shapes) +
  scale_colour_manual(values = char_colors)

Exkurs: Eigene Skalen-Funktion

Wenn ich dieselben Skalen für mehrere Plots nutzen will, kann ich mir auch vorher eine Funktion definieren:

set_char_scales <- function() {
  char_colors <- c(
    "Ted Mosby" = "blue", "Robin Scherbatsky" = "red", "Barney Stinson" = "green", "Lily Aldrin" = "purple", "Marshall Eriksen" = "orange", "Rachel Green" = "pink", "Monica Geller" = "brown", "Phoebe Buffay" = "yellow", "Joey Tribbiani" = "cyan")
  char_shapes <- c("Friends" = 12, "How I Met Your Mother" = 18)
  
  ## Output
  list(
    scale_shape_manual(values = char_shapes),
    scale_colour_manual(values = char_colors)
  )
}

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)
) +
  geom_point(size = 3) +
  set_char_scales()

Anwendungsfälle: Skalen-Ticks

Versuche, die y-Achse so zu skalieren, dass sie von 0 bis 100 geht und in 10er Schritten skaliert ist. Nutze die interne R-Hilfe, aber verzichte auf Internet/KI.

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()
ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  scale_y_continuous(name = "Mittleres Rating", 
                     breaks = seq(0, 100, by = 10), 
                     limits = c(0, 100))

Scale Guides

Jede Skala (und damit jede Aesthetic) bekommt einen Guide zugeordnet. Intern passiert das über guides(). Wir können guides() also nutzen, um die Legende zu stylen:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(color = guide_legend(title = "Charaktere", 
                              ncol = 3, ## Mehr Spalten in der Legende
                              reverse = TRUE, ## Reihenfolge umkehren
                              override.aes = list(size = 3))) ## Größe der Punkte in der Legende ändern

Mögliche guide-Funktionen

  • guide_colourbar()
  • guide_coloursteps()
  • guide_axis()
  • guide_legend()
  • guide_bins()

Nutze das gerade gelernte und versuche, die x-Achsenbeschriftung um 90 Grad zu drehen, um sie lesbar zu machen. Nutze die interne R-Hilfe, aber versuche, es ohne Internet/KI zu lösen:

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point()
ggplot(
  data = dat_prepped,
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90))

Ich nutze außerdem die Spalte top_trait, damit die Achsenbeschriftung kürzer wird. Das sieht schon besser aus, aber wir haben ein Overplotting-Problem!

Faceting



Aufteilen des Plots nach einer oder mehr Gruppen


Foto von Laura Cleffmann auf Unsplash

Faceting

Anordnen von einer einzelnen Variable in einem Raster:

facet_wrap(): Erstellt ein Band aus Kacheln

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")), ## Subset wegen Platzproblemen
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name), nrow = 4)

facet_grid(): Erstellt ein Grid aus Kacheln

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_grid(char_name ~ .)

Facetting - Mehrere Variablen

Anordnen von mehreren Variable in einem Raster:

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name, uni_name), nrow = 4)

ggplot(
  data = dat_prepped %>% filter(char_name %in% c("Robin Scherbatsky", "Monica Geller", "Barney Stinson", "Joey Tribbiani")),
  mapping = aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_grid(char_name ~ uni_name)

Facetting - Tipps

Plot alle Punkte

dat_prepped_background <- dat_prepped %>%
  mutate(char_name_bg = char_name) %>%
  select(-char_name)

ggplot(dat_prepped, aes(x = top_trait, y = avg_rating, colour = char_name, shape = uni_name)) +
  # background lines: drawn in every facet, grouped by country_bg
  geom_point(
    data = dat_prepped_background,
    aes(group = char_name_bg),
    color = "grey70",
    alpha = 0.7,
    size = 0.6
  ) +
  geom_point() +
  guides(x = guide_axis(angle = 90)) +
  facet_wrap(vars(char_name)) +
  guides(color = "none") +
theme_bg()

Facetting - Tipps

Plot Mittelwerte

dat_mean <- dat_prepped %>%
  group_by(question) %>%
  summarise(mean_rating = mean(avg_rating)) %>% 
  ungroup() %>% 
  right_join(dat_prepped)


ggplot(dat_prepped, aes(x = question, y = avg_rating, colour = char_name, shape = uni_name)) +
geom_segment(
    aes(
      x = question, xend = question,
      y = 0, yend = avg_rating,
      group = interaction(char_name, uni_name)
    ),
    linewidth = 0.5,
    alpha = 0.5
  ) +
  geom_point(
    data = dat_mean,
    aes(x = question, y = avg_rating),
    inherit.aes = FALSE,
    color = "grey70",
    size = 1
  ) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  guides(color = "none") +
  theme_bg()

Standardisierung könnte beim Vergleich zwischen den Fragen helfen - das kommt aber auf die finale Fragestellung an. Ist aber ein Punkt, den man zumindest im Hinterkopf behalten sollte.

Sortieren

Sortieren, läuft in ggplot2 oft über factor(). Manchmal kann es hilfreich sein, sich eine eigene ID-Variable zum Sortieren zu erstellen

dat_prepped$uni_name_fac <- factor(dat_prepped$uni_name, levels = c("How I Met Your Mother", "Friends"))
ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(uni_name_fac), nrow = 4) +
  theme_bg()

Themes

Themes

Da würde man ja auch viel zur Legende ändern?

Labels

Kordinatensysteme

Foto von Ujjwal Chettri auf Unsplash

Koordinatensysteme

Zwei Aufgaben:

  • Kombinieren der Positions-Aesthetics (Positions 1 & Position 2) zu einem 2d Raum.
    • Linear: x & y
    • Polar: Winkel und Radius
    • Karte: Breite und Länge
  • Zeichnen der Achsen und Rasterlinien

Typen

Linear

  • coord_cartesian(): Default
  • coord_flip: Tauscht x und y Achse
  • coord_fixed(): Fixes Seitenverhältnis.

Nicht-linear

  • coord_map: Kartenprojektion
  • coord_polar: Polar-Koordinaten (Kreise)
  • coord_trans: Transformation der Positionen

Polar-Koordinaten

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac, group = question)
) +
  geom_point() +
  geom_segment(
    aes(
      x = question, xend = question,
      y = 0, yend = avg_rating,
      group = interaction(char_name, uni_name_fac)
    ),
    linewidth = 0.5
  ) +
  ylim(0, 100) +
  facet_wrap(vars(char_name)) +
  coord_polar(theta = "x")

Vorsicht damit! In vielen Fällen ist ein lineares Koordinatensystem einfacher zu interpretieren. Winkel sind oft nicht so einfach zu interpretieren. Nichtsdestotrotz kann es gerade zur Gestaltung nett sein!

Realistischer Anwendungen

  • Zeitreihen
  • Strecken

Patchwork

dat_prepped_robin <- dat_prepped %>%
  filter(char_name == "Robin Scherbatsky")


p_robin <- ggplot(
  data = dat_prepped_robin,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  ylim(0, 100)



p_rest <- ggplot(
  data = dat_prepped %>% filter(char_name != "Robin Scherbatsky"),
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name), nrow = 2) +
  ylim(0, 100)

Patchwork

Patchwork erlaubt es, Plots zu kombinieren.

library(patchwork)

p_robin +
  p_rest

Patchwork: Stylen

library(patchwork)

p_robin +
  p_rest +
  plot_layout(widths = c(1, 2))

Abschalten der Legende im ersten Plot.

p_robin <- ggplot(
  data = dat_prepped_robin,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name)) +
  ylim(0, 100) +
  theme(legend.position = "none")

p_robin +
  p_rest +
  plot_layout(widths = c(2, 2), guides = "collect")

Text

Labeling

ggplot(
  data = dat_prepped,
  mapping = aes(x = question, y = avg_rating, shape = uni_name_fac)
) +
  geom_label(aes(label = char_name))

ggrepel

library(ggrepel)

ggplot(
  data = dat_prepped,
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text_repel(aes(label = char_name))

Labeling von einzelnen Punkten

Erzeugen einer eigenen Spalte, die nur auf den gewünschten Punkten den Text enthält.

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_label = case_when(
    char_name == "Monica Geller" & top_trait == "orderly" ~ "Monica ist sehr ordentlich",
    TRUE ~ NA
  ))

ggplot(
  data = dat_prepped_2,
  mapping = aes(x = top_trait, y = avg_rating, shape = uni_name_fac, label = char_name_label, color = char_name)
) +
  geom_point() +
  geom_text_repel(nudge_x = 0.75, nudge_y = 1)

ggtext

ggtext erlaubt es, Markdown und HTML-Code in ggplot2 zu nutzen.

library(ggtext)

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_label = case_when(
    char_name == "Monica Geller" & top_trait == "orderly" ~ "Monica ist sehr <span style='color:black'>ordentlich</span>",
    TRUE ~ NA
  ))

ggplot(
  data = dat_prepped_2,
  mapping = aes(x = top_trait, y = avg_rating, shape = uni_name_fac, label = char_name_label, color = char_name)
) +
  geom_point() +
  geom_richtext(
    nudge_x = 0.75, nudge_y = 1, fill = NA, label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt")
  )

ggtext

dat_prepped_2 <- dat_prepped %>%
  mutate(char_name_bold = paste0("**", char_name, "**"))


ggplot(
  data = dat_prepped_2,
  mapping = aes(x = question, y = avg_rating, colour = char_name, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(char_name_bold)) +
  theme(
    strip.text = element_markdown()
  )

Adjustment: hjust/vjust vs. nudge_x/nudge_y

hjust

ggplot( 
  data = dat_prepped %>% filter(char_name == "Lilly Aldrin"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 0.5)

ggplot( 
  data = dat_prepped %>% filter(char_name == "Lilly Aldrin"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 0)

ggplot( 
  data = dat_prepped %>% filter(char_name == "Lilly Aldrin"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), hjust = 1)

vjust

ggplot( 
  data = dat_prepped %>% filter(char_name == "Ted Mosby"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = 1)

ggplot( 
  data = dat_prepped %>% filter(char_name == "Ted Mosby"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = 0)

ggplot( 
  data = dat_prepped %>% filter(char_name == "Ted Mosby"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), vjust = -1)

nudge

Nudging erfolgt auf der gleichen Skala wie die Werte.

::: {.column width=“50%”}}

Nudge um eine halbe Einheit nach rechts.

ggplot( 
  data = dat_prepped %>% filter(char_name == "Rachel Green"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), nudge_x = 0.5)

::: {.column width=“50%”}}

Nudge um 5 Einheiten nach unten.

ggplot( 
  data = dat_prepped %>% filter(char_name == "Rachel Green"),
  mapping = aes(x = bottom_trait, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  geom_text(aes(label = char_name), nudge_y = -5)

::: :::

Bilder

image_path <- here::here("sessions", "more_ggplot","images", "character_images")

dat_prepped <- dat_prepped %>% 
mutate(image_link_local = paste0(image_path, "/", id, ".jpg"))
library(tidyverse)
library(ggtext)
library(glue)

ggplot(
  data = dat_prepped,
  mapping = aes(x = image_link_local, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(question), nrow = 2) +
  ylim(0, 100) +
  scale_x_discrete(
    labels = \(x) glue("<img src='{x}' height='24' />")
  ) +
  theme(
    axis.text.x = element_markdown()
  ) +
  coord_cartesian(clip = "off") # falls Bilder abgeschnitten werden

Themes

Themes

library(tidyverse)
library(ggtext)
library(glue)

ggplot(
  data = dat_prepped,
  mapping = aes(x = image_link_local, y = avg_rating, shape = uni_name_fac)
) +
  geom_point() +
  facet_wrap(vars(question), nrow = 2) +
  ylim(0, 100) +
  scale_x_discrete(
    labels = \(x) glue("<img src='{x}' height='24' />")
  ) +
  theme(
    axis.text.x = element_markdown()
  ) +
  coord_cartesian(clip = "off") # falls Bilder abgeschnitten werden

Let’s bring it together: Spider-Chat

Step by step

# traits <- c("doer/thinker", "jock/nerd", "cold/warm", "main character/side character", "crazy/sane")
# line<-data.frame(x=rep(traits,2),y=c(rep(0, length(traits)),rep(100, length(traits))))


ggplot(
  dat_prepped,
  aes(x = question, y = avg_rating, group = char_name)
) +
  geom_point()

Spider-Chart

ggplot(
  dat_prepped,
  aes(x = question, y = avg_rating, group = char_name)
) +
  geom_point() +
  facet_wrap(vars(char_name), ncol = 4)

Vergleichen von ähnlichen Charakteren

Dafür erzeuge ich eine eigene Variable

dat_prepped2 <- dat_prepped %>%
  mutate(facet_id = case_when(
    char_name %in% c("Barney Stinson", "Joey Tribbiani") ~ "Barney & Joey",
    char_name %in% c("Ted Mosby", "Ross Geller") ~ "Ted & Ross",
    char_name %in% c("Robin Scherbatsky", "Rachel Green") ~ "Robin & Rachel",
    char_name %in% c("Lily Aldrin", "Monica Geller") ~ "Lily & Monica",
    char_name %in% c("Marshall Eriksen", "Chandler Bing") ~ "Marshall & Chandler"
  )) %>%
  filter(!is.na(facet_id)) ## Sorry Phoebe :(

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100)

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_polar()

ggplot(
  dat_prepped2,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.5) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_polar()

Radar coords from Tanya Shapiro

Code 
coord_radar <- function(theta = "x", start = 0, direction = 1) {
  theta <- match.arg(theta, c("x", "y"))
  r <- if (theta == "x") {
    "y"
  } else {
    "x"
  }

  # dirty
  rename_data <- function(coord, data) {
    if (coord$theta == "y") {
      plyr::rename(data, c("y" = "theta", "x" = "r"), warn_missing = FALSE)
    } else {
      plyr::rename(data, c("y" = "r", "x" = "theta"), warn_missing = FALSE)
    }
  }
  theta_rescale <- function(coord, x, scale_details) {
    rotate <- function(x) (x + coord$start) %% (2 * pi) * coord$direction
    rotate(scales::rescale(x, c(0, 2 * pi), scale_details$theta.range))
  }

  r_rescale <- function(coord, x, scale_details) {
    scales::rescale(x, c(0, 0.4), scale_details$r.range)
  }

  ggproto("CordRadar", CoordPolar,
    theta = theta, r = r, start = start,
    direction = sign(direction),
    is_linear = function(coord) TRUE,
    render_bg = function(self, scale_details, theme) {
      scale_details <- rename_data(self, scale_details)

      theta <- if (length(scale_details$theta.major) > 0) {
        theta_rescale(self, scale_details$theta.major, scale_details)
      }
      thetamin <- if (length(scale_details$theta.minor) > 0) {
        theta_rescale(self, scale_details$theta.minor, scale_details)
      }
      thetafine <- seq(0, 2 * pi, length.out = 100)

      rfine <- c(r_rescale(self, scale_details$r.major, scale_details))

      # This gets the proper theme element for theta and r grid lines:
      #   panel.grid.major.x or .y
      majortheta <- paste("panel.grid.major.", self$theta, sep = "")
      minortheta <- paste("panel.grid.minor.", self$theta, sep = "")
      majorr <- paste("panel.grid.major.", self$r, sep = "")

      ggplot2:::ggname("grill", grid::grobTree(
        ggplot2:::element_render(theme, "panel.background"),
        if (length(theta) > 0) {
          ggplot2:::element_render(
            theme, majortheta,
            name = "angle",
            x = c(rbind(0, 0.4 * sin(theta))) + 0.5,
            y = c(rbind(0, 0.4 * cos(theta))) + 0.5,
            id.lengths = rep(2, length(theta)),
            default.units = "native"
          )
        },
        if (length(thetamin) > 0) {
          ggplot2:::element_render(
            theme, minortheta,
            name = "angle",
            x = c(rbind(0, 0.4 * sin(thetamin))) + 0.5,
            y = c(rbind(0, 0.4 * cos(thetamin))) + 0.5,
            id.lengths = rep(2, length(thetamin)),
            default.units = "native"
          )
        },
        ggplot2:::element_render(
          theme, majorr,
          name = "radius",
          x = rep(rfine, each = length(thetafine)) * sin(thetafine) + 0.5,
          y = rep(rfine, each = length(thetafine)) * cos(thetafine) + 0.5,
          id.lengths = rep(length(thetafine), length(rfine)),
          default.units = "native"
        )
      ))
    }
  )
}
dat_prepped3 <- arrange(dat_prepped2, question)

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = char_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.5) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar()

https://de.pinterest.com/pin/friends-colors–2955556002181108/

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg()

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets", )

library(ggimage)

dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "doer/thinker", "crazy/sane")
  )

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets") +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
    nudge_x = c(0.5, -0.5),
    size = 0.1, inherit.aes = FALSE
  ) +
  NULL

Adding a frame around the picture

library(ggimage)

dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "doer/thinker", "crazy/sane")
  )

ggplot(
  dat_prepped3,
  aes(x = question, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  scale_color_manual(values = c("Friends" = "#00009E", "How I Met Your Mother" = "yellow")) +
  theme_bg() +
  labs(title = "The one where Everyone meets") +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
    nudge_x = c(0.5, -0.5),
    size = 0.12
  ) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
    nudge_x = c(0.5, -0.5),
    size = 0.1, inherit.aes = FALSE
  ) +
  NULL

Styling

  • Anchor points on top to show max
  • Style
  • Nudge pictures further out
dat_prepped3 <- dat_prepped3 %>%
  mutate(
    image_x = ifelse(uni_name == "Friends", -1, 1),
    image_x_coord = ifelse(uni_name == "Friends", "low IQ", "side character")
  ) %>%
  arrange(top_trait)

outer_points <- dat_prepped3 %>%
  mutate(
    max_rating = 100,
    label_y = 90, 
    nudge_x = ifelse(uni_name == "Friends", -0.14, 0.14)
  )

ggplot(
  dat_prepped3,
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points$nudge_x, size = 2
  ) +
  geom_point() +
  geom_polygon(alpha = 0.1) +
  facet_wrap(vars(facet_id), ncol = 4) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
  labs(title = "The one where Everyone meets") +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white", face = "bold"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#06402B"), 
    plot.background = element_rect(fill = '#06402B'), 
    title = element_text(color = "white", size = 16, face = "bold"), 
    strip.background = element_rect(fill = "#06402B"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.background = element_rect(fill = "#06402B"), 
    legend.text = element_text(color = "white")
  )

dat_joey_barney <- dat_prepped3 %>%
  filter(char_name %in% c("Barney Stinson", "Joey Tribbiani"))


  outer_points_joey_barney <- dat_joey_barney %>%
  mutate(
    max_rating = 100,
    label_y = 95, 
    nudge_x = ifelse(uni_name == "Friends", -0.1, 0.1)
  )
    
p_left <- ggplot(
  dat_joey_barney,
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points_joey_barney, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points_joey_barney, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points_joey_barney$nudge_x, size = 2.75
  ) +
  geom_point(size = 3) +
  geom_polygon(alpha = 0.2, linewidth = 1.5) +
  facet_wrap(vars(facet_id), ncol = 2) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
  labs(title = "The one where Everyone meets", 
       subtitle = "Character ratings from 0 to 100") +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white", face = "bold"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#06402B"), 
    plot.background = element_rect(fill = '#06402B'), 
    title = element_text(color = "white", size = 16, face = "bold"), 
    strip.background = element_rect(fill = "#06402B"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.background = element_rect(fill = "#06402B"), 
    legend.position = "none"
  ) 
outer_points2 <- outer_points %>%
  filter(!char_name %in% c("Barney Stinson", "Joey Tribbiani"))

p_right <- ggplot(
  dat_prepped3 %>% filter(!char_name %in% c("Barney Stinson", "Joey Tribbiani")),
  aes(x = top_trait, y = avg_rating, group = char_name, color = uni_name, fill = uni_name)
) +
  geom_point(data = outer_points2, aes(top_trait, max_rating), color = "white", inherit.aes = FALSE) +
  geom_richtext(
    data = outer_points2, aes(top_trait, label_y, label = round(avg_rating, 0), color = uni_name), inherit.aes = FALSE, fill = NA, label.color = NA,
    label.padding = grid::unit(rep(0, 4), "pt"), nudge_x = outer_points2$nudge_x, size = 2.75
  ) +
  geom_point(size = 3) +
  geom_polygon(alpha = 0.2, linewidth = 1) +
  facet_wrap(vars(facet_id), ncol = 2) +
  ylim(0, 100) +
  coord_radar() +
  scale_fill_manual(values = c("Friends" = "#36d1ab", "How I Met Your Mother" = "#FFED29")) +
  scale_color_manual(values = c("Friends" = "#9C8CD4", "How I Met Your Mother" = "#FFED29")) +
  theme_bw() +
    geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.12) +
  geom_image(aes(x = image_x_coord, y = 100, image = image_link_local),
             nudge_x = -0.35,
             nudge_y = 30,
             size=0.1, inherit.aes = FALSE) +
  theme(
    axis.ticks = element_blank(),
    axis.text.x = element_text(color = "white"), 
    axis.text.y = element_blank(), 
    axis.title = element_blank(), 
    panel.background = element_rect(fill = "#053625"), 
    plot.background = element_rect(fill = '#053625'), 
    strip.background = element_rect(fill = "#053625"), 
    strip.text = element_text(color = "white", face = "bold"), 
    legend.position = "none"
  )
  • Eventuell in Funktionen packen was geht

Patch together

p_left +
  p_right

Abspeichern

Vektor vs Raster (Rolfs 7)

Use characters data for demonstration or for exercise?